home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Visual Basic Source Code
/
Visual Basic Source Code.iso
/
vbsource
/
joystick
/
game.frm
< prev
next >
Wrap
Text File
|
1993-09-05
|
12KB
|
381 lines
VERSION 2.00
Begin Form gameform
BackColor = &H00FFFFFF&
BorderStyle = 3 'Fixed Double
Caption = "Joystick Skeet Shoot"
ClientHeight = 8490
ClientLeft = 1005
ClientTop = 1695
ClientWidth = 10455
Height = 9150
Left = 960
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 8490
ScaleWidth = 10455
Top = 1080
Width = 10545
Begin Joystick Joystick1
Left = 120
Top = 7920
End
Begin Line Line1
BorderColor = &H00000000&
BorderWidth = 2
X1 = 0
X2 = 10440
Y1 = 7680
Y2 = 7680
End
Begin Label Label4
Alignment = 2 'Center
BackColor = &H00FFFFFF&
Caption = "SCORE"
Height = 255
Left = 6240
TabIndex = 3
Top = 7800
Width = 3495
End
Begin Label Label3
Alignment = 2 'Center
BackColor = &H00FFFFFF&
Caption = "SHOTS"
Height = 255
Left = 1440
TabIndex = 2
Top = 7800
Width = 2535
End
Begin Label Label2
Alignment = 2 'Center
BackColor = &H00FFFFFF&
Caption = "0"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 12
FontStrikethru = 0 'False
FontUnderline = 0 'False
ForeColor = &H000000FF&
Height = 255
Left = 1560
TabIndex = 1
Top = 8160
Width = 2295
End
Begin Label Label1
Alignment = 2 'Center
BackColor = &H00FFFFFF&
Caption = "0000"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 12
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 255
Left = 6360
TabIndex = 0
Top = 8160
Width = 3255
End
Begin Menu mnugame
Caption = "&Game"
Begin Menu mnunew
Caption = "&New"
Shortcut = {F2}
End
Begin Menu mnupause
Caption = "&Pause"
Shortcut = {F3}
End
Begin Menu mnustop
Caption = "&Exit"
Shortcut = {F4}
End
End
Begin Menu mnuoptions
Caption = "&Options"
Begin Menu mnuspeed
Caption = "&Speed"
Begin Menu mnufast
Caption = "&Fast"
Index = 0
End
Begin Menu mnufast
Caption = "&Medium"
Index = 1
End
Begin Menu mnufast
Caption = "&Slow"
Checked = -1 'True
Index = 2
End
End
Begin Menu mnutargets
Caption = "&Targets"
Begin Menu mnumultiple
Caption = "&Single"
Checked = -1 'True
Index = 0
End
Begin Menu mnumultiple
Caption = "&Multiple"
Index = 1
End
End
End
End
DefInt A-Z
Dim tsize As Integer
Dim tdelay As Integer
Dim tcount As Integer
Dim targetx As Integer
Dim targety As Integer
Dim capcolor As Long
Dim score As Long
Dim lppoint As pointapi
Dim kill_target As Integer
Dim shots As Integer
Dim master_time As Single
Dim game_over As Integer
Dim pause_flag As Integer
Dim target(1 To 3) As target_data
Sub draw_target (x As Integer, y As Integer, cqb)
'Debug.Print x, y, cqb
gameform.DrawMode = 7' xor mode
gameform.Line (x, y)-(x + tsize, y + tsize), QBColor(cqb), BF
End Sub
Sub Form_Load ()
tsize = 500
tdelay = 4
tcount = 1
xmax = 20000
ymax = 20000
xmin = 0
ymin = 0
calx = 0
caly = 0
button_mark = False
mousepointer = 2
shots = 50
winxmax = gameform.ScaleLeft + gameform.ScaleWidth
winxmin = gameform.ScaleLeft
winymin = gameform.ScaleTop
winymax = gameform.ScaleTop + gameform.ScaleHeight
joystick1.Capture = True
xmax = getprivateprofileint("gameform", "xmax", -1, "joytest.ini")
If xmax = -1 Then
need_calibrate = True
Else
xmin = getprivateprofileint("gameform", "xmin", -1, "joytest.ini")
ymax = getprivateprofileint("gameform", "ymax", -1, "joytest.ini")
ymin = getprivateprofileint("gameform", "ymin", -1, "joytest.ini")
End If
deltax = gameform.ScaleWidth / xmax
deltay = gameform.ScaleHeight / ymax
loop_count = 0
Do
time1! = Timer
count1 = 0
Do
DoEvents
count1 = count1 + 1
Loop While Timer - time1! < 1
loop_time = loop_time + count1
loop_count = loop_count + 1
Loop While loop_count < 2
master_time = Int(loop_time / loop_count)
Randomize
game_over = False
End Sub
Sub Joystick1_ButtonDown (button As Integer)
button_mark = True
If need_calibrate Then Exit Sub
Select Case button
Case 1
'Circle (winpoint.x, winpoint.y), 80, RGB(0, 0, 0)
'fillcolor = QBColor(0)
Case 2
'picture2.Circle (winpoint.x, winpoint.y), 80, RGB(0, 0, 0)
'fillcolor = QBColor(0)
getcursorpos lppoint
ScreenToClient gameform.hWnd, lppoint
lppoint.x = lppoint.x * screen.TwipsPerPixelX
lppoint.y = lppoint.y * screen.TwipsPerPixelY
For i = 1 To tcount
If lppoint.x > target(i).x And lppoint.x < target(i).x + tsize Then
If lppoint.y > target(i).y And lppoint.y < target(i).y + tsize Then
Beep
score = score + 10 * tdelay
label1.Caption = Str(score)
target(i).kill_target = True
End If
End If
Next i
shots = shots - 1
label2.Caption = Str(shots)
If shots = 0 Then
game_over = True
MsgBox "Game Over!", 0, "Joystick Skeet Shoot"
End If
End Select
End Sub
Sub Joystick1_Move (x As Integer, y As Integer, z As Integer)
calx = x
caly = y
If need_calibrate Then
Call calibrate(gameform)
If need_calibrate <> True Then
t = writeprivateprofilestring("gameform", "xmax", ByVal Format$(xmax), "joytest.ini")
t = writeprivateprofilestring("gameform", "ymax", ByVal Format$(ymax), "joytest.ini")
t = writeprivateprofilestring("gameform", "xmin", ByVal Format$(xmin), "joytest.ini")
t = writeprivateprofilestring("gameform", "ymin", ByVal Format$(ymin), "joytest.ini")
End If
Exit Sub
End If
convert x, y, gameform
'Debug.Print "* "; winpoint.x, winpoint.y
End Sub
Sub mnufast_Click (index As Integer)
Select Case index
Case 0' fast
tdelay = 8
mnufast(1).Checked = False
mnufast(2).Checked = False
Case 1' medium
tdelay = 4
mnufast(0).Checked = False
mnufast(2).Checked = False
Case 2' slow
tdelay = 2
mnufast(0).Checked = True
mnufast(1).Checked = True
End Select
mnufast(index).Checked = True
End Sub
Sub mnumultiple_Click (index As Integer)
Select Case index
Case 0
tcount = 1
Case 1
tcount = 2
End Select
End Sub
Sub mnunew
